home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -in_the_mag- / banging_the_metal / qdos / qdos4amiga3.lha / SYS_REF_bas < prev    next >
Text File  |  1998-02-24  |  21KB  |  641 lines
  1. 10  TURBO_objfil "ram1_SYS_REF_task"
  2. 11  TURBO_taskn "SYS_REF"
  3. 12  TURBO_repfil "scr"
  4. 13  TURBO_windo 0
  5. 14  TURBO_diags 'omit'
  6. 15  TURBO_struct "S"
  7. 16  TURBO_model "<"
  8. 17  TURBO_objdat 10
  9. 18  TURBO_optim "R"
  10. 19 :
  11. 1000 REMark ------------------------------
  12. 1010 REMark    SYS_REF_bas - Mark J Swift
  13. 1070 REMark ------------------------------
  14. 1080 :
  15. 1170 DIM InFile$(100),OutFile$(100),Rplc$(1),P$(256),Src$(5),Dst$(40),Name$(40),Space$(40),temp$(40),nam$(64),pch$(256),a$(100),verstag$(4)
  16. 1180 verstag$="1.10"
  17. 1190 Buff=ALCHP(256)
  18. 1200 Rows=14
  19. 1210 DIM D(Rows/2)
  20. 1220 OPEN#3;"Con_456x234a28x12"
  21. 1230 OPEN#4;"Scr_104x12a362x20"
  22. 1240 OPEN#5;"Scr_436x142a38x99"
  23. 1250 InFlg%=0
  24. 1260 REPeat outer_loop
  25. 1262  RETRY_HERE
  26. 1264  IF InFlg%<>0 THEN CLOSE#7:DELETE Dst$&"SYS_REF_dat":InFlg%=0
  27. 1270  IF COMPILED
  28. 1271   WHEN ERRor 
  29. 1272    PRINT #3\\"Error: "
  30. 1273    REPORT #3,ERNUM
  31. 1274    INPUT #3;\" Press ENTER to re-start.";Rplc$
  32. 1275    RETRY
  33. 1276   END WHEN 
  34. 1277  END IF 
  35. 1279  WINDOW#3;456,234,28,12:PAPER#3;0:INK#3;7:CLS#3:BORDER#3;3,2:BORDER#3;2,0:BORDER#3;1,2:WINDOW#3;438,220,36,19:BORDER#5;1,4:INK#5;4:PAPER#5;0
  36. 1280  CSIZE#3;2,1:PRINT#3;"SYS_REF v";verstag$:CSIZE#3;0,0
  37. 1290  PRINT#3;"CODE-PATCHER by MARK J SWIFT";
  38. 1300  CLS#4:BORDER#4;1,7:INK#4;4:CLS#5
  39. 1310  WINDOW#3;438,40,36,59
  40. 1320  IF InFlg%=0 THEN 
  41. 1330   INK#5;4
  42. 1340   PRINT#5;" Use SYS_REF to patch tasks & M/C that fail when the system"
  43. 1350   PRINT#5;" variables are moved from the usual $28000 location"
  44. 1360   PRINT#5;" (i.e. under Minerva or Amiga-QDOS with the 2nd screen enabled)."
  45. 1380   PRINT#5;\" If patching CODEGEN_task of the TURBO compiler, patch all references"
  46. 1390   PRINT#5;" EXCEPT the two that refer to $28010. These are not part of the CODEGEN"
  47. 1400   PRINT#5;" code, but are included in all TURBO compiled programs. If patching"
  48. 1410   PRINT#5;" PARSER_task, or any other TURBO program replace ALL references."
  49. 1420   PRINT#5;\" Patched versions of TURBO produce code identical to unpatched"
  50. 1430   PRINT#5;" versions, i.e. compiled tasks still require patching."
  51. 1440   PRINT#5;\" NOTE: SYS_REF makes all TURBO'ed & some QLIB'ed programs 32-bit clean."
  52. 1450   INPUT#3;\"Input FILE or VOLUME name  >";InFile$
  53. 1460   IF InFile$="" THEN EXIT outer_loop
  54. 1470   IF LEN(InFile$)=5 THEN 
  55. 1480    InFlg%=INT(((InFile$ INSTR "flp1_flp2_flp3_flp4_ram1_ram2_")+4)/5)
  56. 1490   ELSE 
  57. 1500    InFlg%=0
  58. 1510   END IF 
  59. 1520   IF InFlg%=0 THEN 
  60. 1530    INPUT#3;"         Output FILE name  >";OutFile$
  61. 1540    IF OutFile$="" THEN EXIT outer_loop
  62. 1550   ELSE 
  63. 1560    INPUT#3;"       Output VOLUME name  >";OutFile$
  64. 1570    IF OutFile$="" THEN InFlg%=0:EXIT outer_loop
  65. 1580    Src$=InFile$:Dst$=OutFile$
  66. 1590    DELETE Dst$&"SYS_REF_dat"
  67. 1600    OPEN_NEW#7;Dst$&"SYS_REF_dat"
  68. 1610    DIR#7;Src$:CLOSE#7
  69. 1620    OPEN_IN#7;Dst$&"SYS_REF_dat"
  70. 1630    INPUT#7;Name$,Space$
  71. 1640   END IF 
  72. 1650   CLS#5
  73. 1660  END IF 
  74. 1670  REPeat main_loop
  75. 1680   REPeat in_loop
  76. 1690    CLS#4:CLS#3:RPORT CHR$(10)
  77. 1700    IF InFlg%<>0 THEN 
  78. 1710     IF EOF(#7) THEN 
  79. 1720      EXIT main_loop
  80. 1730     ELSE 
  81. 1740      INPUT#7;InFile$
  82. 1750      OutFile$=Dst$&InFile$
  83. 1760      InFile$=Src$&InFile$
  84. 1770     END IF 
  85. 1780    END IF 
  86. 1790    OPEN_IN#6;InFile$
  87. 1800    el=0:fd=0:fl=FLEN(#6):ft=FTYP(#6):IF ft THEN fd=FDAT(#6)
  88. 1810    CLOSE#6
  89. 1820    RPORT "File: "&InFile$&CHR$(10)
  90. 1830    IF fl=0 THEN 
  91. 1840     RPORT "File empty!"&CHR$(10)
  92. 1850     IF InFlg%=0 THEN EXIT main_loop
  93. 1860    ELSE 
  94. 1861     INK#3;4
  95. 1862     IF ft=1 AND fd<>0 THEN 
  96. 1864      RPORT "Executable TASK"&CHR$(10)
  97. 1866     ELSE 
  98. 1870      temp$=FILE_CLASS$(InFile$)
  99. 1880      IF temp$<>"" THEN 
  100. 1890       RPORT "Possible "&temp$&CHR$(10)
  101. 1900      END IF 
  102. 1902     END IF 
  103. 1904     INK#3;7
  104. 1910     IF InFlg%=0 THEN 
  105. 1920      EXIT in_loop
  106. 1930     ELSE 
  107. 1940      RPORT "Patch":Rplc$=WAITKEY$(3,"ynq")
  108. 1950      IF Rplc$=="y" THEN EXIT in_loop
  109. 1960      IF Rplc$=="q" THEN EXIT main_loop
  110. 1970     END IF 
  111. 1980    END IF 
  112. 1990   END REPeat in_loop
  113. 2000   CLS#5
  114. 2010   base=ALCHP(fl)
  115. 2020   IF base>0 THEN 
  116. 2030    LBYTES (InFile$(1 TO LEN(InFile$))),base
  117. 2040   ELSE 
  118. 2050    PRINT#3;\"Out of memory!"
  119. 2060    EXIT outer_loop
  120. 2070   END IF 
  121. 2080   REMark do it
  122. 2090   NoRpc%=0
  123. 2100   fixSYSV
  124. 2110   IF NoRpc% THEN 
  125. 2120    RPORT "Saving..."&CHR$(10)
  126. 2125    s=base
  127. 2127    IF el<0 THEN 
  128. 2128     s=base-el
  129. 2129    END IF 
  130. 2130    IF ft=1 THEN 
  131. 2140     DELETE OutFile$
  132. 2150     SEXEC OutFile$,s,fl,fd
  133. 2160    ELSE 
  134. 2170     DELETE OutFile$
  135. 2180     SBYTES OutFile$,s,fl
  136. 2190    END IF 
  137. 2200   ELSE 
  138. 2210    RPORT "No changes."&CHR$(10)
  139. 2220   END IF 
  140. 2230   RECHP(base)
  141. 2240   IF (InFlg%=0) OR (NoRpc%=0) THEN 
  142. 2250    Rplc$=INKEY$(#3,200)
  143. 2260    IF InFlg%=0 THEN EXIT main_loop
  144. 2270   END IF 
  145. 2280  END REPeat main_loop
  146. 2310 END REPeat outer_loop
  147. 2320 RECHP(Buff)
  148. 2330 CLOSE#3
  149. 2340 CLOSE#4
  150. 2350 CLOSE#5
  151. 2360 IF InFlg%<>0 THEN CLOSE#7:DELETE OutFile$&"SYS_REF_dat":InFlg%=0
  152. 2370 STOP
  153. 2380 :
  154. 2390 DEFine PROCedure fixSYSV
  155. 2400  LOCal a,p,i,N,pk,pflg%
  156. 2410  CLS#4
  157. 2420  tskFlg%=((PEEK_W(base+6)=HEX("4AFB")) AND (ft<>0))
  158. 2430  IF tskFlg% THEN 
  159. 2440   nam$=""
  160. 2450   pk=PEEK_W(base+8)
  161. 2460   FOR i=0 TO pk-1
  162. 2470    nam$=nam$&CHR$(PEEK(base+10+i))
  163. 2480   END FOR i
  164. 2490   p=base+4+(6+2*INT((LEN(nam$)+1)/2))
  165. 2500  ELSE 
  166. 2510   p=base+4
  167. 2520  END IF 
  168. 2526  pflg%=0:pch$="":ol=0:versold$=verstag$
  169. 2530  IF PEEK_L(p)=HEX("50544348") THEN 
  170. 2531   versold$=LONGINT$(PEEK_L(p+4))
  171. 2532   IF STRINGL(versold$)<STRINGL(verstag$) THEN 
  172. 2533    RPORT "...patched by an outdated version of SYS_REF ":p=p+8
  173. 2534    IF versold$>="1.08" THEN 
  174. 2535     ol=PEEK_L(p):NoRpc%=PEEK_W(p+4):p=p+6
  175. 2536    ELSE 
  176. 2537     NoRpc%=PEEK_W(p):p=p+2
  177. 2542     IF tskFlg% THEN 
  178. 2543      ol=78+4*NoRpc%+2*INT((LEN(nam$)+1)/2)
  179. 2544     ELSE 
  180. 2545      ol=60+LEN(pch$)
  181. 2546     END IF 
  182. 2547     IF versold$=="1.07" THEN 
  183. 2549      ol=66+40+ol
  184. 2552     END IF 
  185. 2553    END IF 
  186. 2554    FOR N=1 TO NoRpc%
  187. 2555     pch$=pch$&LONGINT$(PEEK_L(p)):p=p+4
  188. 2556    END FOR N
  189. 2600   ELSE 
  190. 2610    pflg%=1
  191. 2620    RPORT "...already patched by a current version of SYS_REF "
  192. 2630   END IF 
  193. 2640   RPORT "(v"&versold$&")"&CHR$(10)
  194. 2650  ELSE 
  195. 2660   p=0
  196. 2670   REPeat find_loop
  197. 2680    IF p>fl THEN EXIT find_loop
  198. 2690    FOR N=1 TO 256
  199. 2700     pk=PEEK_L(base+p)
  200. 2710     IF (pk>=HEX("28000")) AND (pk<HEX("28200")) THEN 
  201. 2720      DISOUT
  202. 2730      IF NOT(Rplc$=="a") THEN 
  203. 2740       RPORT "REPLACE":Rplc$=WAITKEY$(3,"ynaq")
  204. 2750       IF Rplc$=="q" THEN 
  205. 2760        pch$="":EXIT find_loop
  206. 2770       END IF 
  207. 2780      END IF 
  208. 2790      IF (Rplc$=="y") OR (Rplc$=="a") THEN 
  209. 2800       pch$=pch$&LONGINT$(p)
  210. 2810       NoRpc%=NoRpc%+1
  211. 2820      END IF 
  212. 2830     END IF 
  213. 2840     p=p+2
  214. 2850     IF p>=fl THEN EXIT N
  215. 2860    END FOR N
  216. 2870    IF p>fl THEN 
  217. 2880     BLOCK#4;100,10,0,0,4
  218. 2890    ELSE 
  219. 2900     BLOCK#4;INT((p/fl)*100),10,0,0,4
  220. 2910    END IF 
  221. 2920   END REPeat find_loop
  222. 2925  END IF 
  223. 2930  IF pch$<>"" THEN 
  224. 2940   IF tskFlg% THEN 
  225. 2950    xl=56+20+4+78+LEN(pch$)+2*INT((LEN(nam$)+1)/2)
  226. 2960   ELSE 
  227. 2970    xl=56+20+4+60+LEN(pch$)
  228. 2980   END IF 
  229. 2982   el=xl-ol
  230. 2983   p=0
  231. 2984   IF ol<>0 THEN 
  232. 2985    RPORT "removing old patches - $"&HEX$(ol,32)&" bytes"&CHR$(10)
  233. 2987   END IF 
  234. 2988   IF xl<>0 THEN 
  235. 2989    RPORT "Extending file by $"&HEX$(xl,32)&" bytes"&CHR$(10)
  236. 2990   END IF 
  237. 2995   IF el<>0 THEN 
  238. 2998    IF el>0 THEN 
  239. 2999     RECHP(base):fl=fl+el:base=ALCHP(fl)
  240. 3010     LBYTES InFile$,base+el
  241. 3012    ELSE 
  242. 3013     p=-el
  243. 3014     fl=fl+el
  244. 3015    END IF 
  245. 3020   END IF 
  246. 3030   REMark start:
  247. 3040   po "6000":POKE_W base+p,2+tskFlg%*(2+2+2+2*INT((LEN(nam$)+1)/2))+8+2+LEN(pch$)+4+28*2:p=p+2:REMark bra skip
  248. 3050   IF tskFlg% THEN 
  249. 3060    po "0000"
  250. 3070    po "4AFB":REMark dc.w $4afb
  251. 3080    REMark jobname:
  252. 3090    POKE_W base+p,LEN(nam$):p=p+2
  253. 3100    FOR i=1 TO LEN(nam$):POKE base+p+i-1,CODE(nam$(i)):NEXT i:p=p+2*INT((LEN(nam$)+1)/2)
  254. 3110   END IF 
  255. 3120   po "5054":po "4348":POKE_L base+p,STRINGL(verstag$):p=p+4:REMark dc.b 'PTCHx.xx'
  256. 3125   POKE_L base+p,xl:p=p+4
  257. 3130   REMark patch_tbl:
  258. 3140   POKE_W base+p,LEN(pch$)/4:p=p+2
  259. 3150   FOR i=1 TO LEN(pch$)-3 STEP 4:POKE_L base+p,STRINGL(pch$(i TO i+3)):p=p+4:NEXT i
  260. 3151   REMark setcach:
  261. 3152   RESTORE 3445
  262. 3153   FOR i=1 TO 28
  263. 3154    READ temp$:po temp$
  264. 3155   END FOR i
  265. 3160   REMark skip:
  266. 3162   po "4E40":REMark trap#0 - supervisor mode
  267. 3164   po "007C":po "0700":REMark ori #$0700,sr - no ints
  268. 3170   po "48E7":po "E3F0": REMark movem.l d0-d2/d6/d7/a0-a3,-(a7)
  269. 3180   po "7000":REMark moveq #0,d0
  270. 3190   po "4E41":REMark trap #1
  271. 3192   po "7000":REMark moveq #0,d0
  272. 3194   po "61B6":REMark bsr.s setcach
  273. 3196   po "2E00":REMark move.l d0,d7
  274. 3200   po "45FA":POKE_W base+p,44+12*tskFlg%:p=p+2:REMark lea patch_end(pc),a2
  275. 3210   po "43FA":POKE_W base+p,HEX("FFF0")-68-LEN(pch$):p=p+2:REMark lea patch_tbl(pc),a1
  276. 3220   po "3219":REMark move.w (a1)+,d1
  277. 3230   po "6012":REMark bra.s svdbra
  278. 3240   REMark svloop:
  279. 3250   po "2419":REMark move.l (a1)+,d2
  280. 3260   po "2032":po "2800":REMark move.l (a2,d2),d0
  281. 3270   po "0280":po "0000":po "7FFF":REMark andi.l #$7FFF,d0
  282. 3280   po "D088":REMark add.l a0,d0
  283. 3290   po "2580":po "2800":REMark move.l d0,(a2,d2)
  284. 3300   REMark svdbra:
  285. 3310   po "51C9":po "FFEC":REMark dbra d1,svloop
  286. 3312   po "2007":REMark move.l d7,d0
  287. 3314   po "618E":REMark bsr.s setcach
  288. 3320   IF tskFlg% THEN 
  289. 3330    po "203C":po "0000":POKE_W base+p,xl:p=p+2:REMark move.l #patch_end-start,d0
  290. 3340    po "DDC0":REMark adda.l d0,a6
  291. 3350    po "99C0":REMark suba.l d0,a4
  292. 3360    po "9BC0":REMark suba.l d0,a5
  293. 3370   END IF 
  294. 3380   po "4CDF":po "0FC7":REMark movem.l (a7)+,d0-d2/d6/d7/a0-a3
  295. 3382   po "027C":po "D8FF":REMark andi #-$2701,sr - user mode
  296. 3390   REMark patch_end:
  297. 3420  END IF 
  298. 3432  IF pflg%=0 THEN 
  299. 3435   fixTURBO
  300. 3436   IF RecogFlg%=0 THEN fixQLIB
  301. 3438  END IF 
  302. 3440 END DEFine 
  303. 3441 :
  304. 3442 REMark DATA CACHE disable subroutine
  305. 3445 DATA "2F01","0C28","0010","00A1","632A","4E7A","1002","C340"
  306. 3446 DATA "0041","0808","0C28","0030","00A1","6314","4A40","6A02"
  307. 3447 DATA "F4B8","4A80","6A06","F478","4A81","6B02","F458","F498"
  308. 3448 DATA "4E7B","1002","221F","4E75"
  309. 3460 DEFine PROCedure fixTURBO
  310. 3470  LOCal p,Q,N,find_loop
  311. 3480  RecogFlg%=0
  312. 3485  p=9984:IF fl<p THEN p=fl
  313. 3490  X=find(LONGINT$(HEX("20087E00"))&LONGINT$(HEX("24790002"))&LONGINT$(HEX("801045EA"))&LONGINT$(HEX("00682A0A")),FILL$(CHR$(255),16),base,0,p)
  314. 3660  IF X<>-1 THEN 
  315. 3665   RecogFlg%=-1
  316. 3670   RPORT "TURBO TASK:"&CHR$(10)
  317. 3680   unfixTURBO
  318. 3690   p=0:CLS#4:CLS#5
  319. 3700   REPeat find_loop
  320. 3710    IF p>fl THEN EXIT find_loop
  321. 3720    FOR N=1 TO 256
  322. 3730     temp$=HEX$(PEEK_L(base+p),32)
  323. 3740     IF temp$(1 TO 6)=="422E8A" THEN 
  324. 3750      POKE_L base+p,HEX("422E801D"):DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  325. 3760     ELSE 
  326. 3770      IF temp$(1 TO 6)=="57EE8A" THEN 
  327. 3780       POKE_L base+p,HEX("57EE801D"):DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  328. 3790      ELSE 
  329. 3800       IF temp$(1 TO 6)=="4A2E8A" THEN 
  330. 3810        POKE_L base+p,HEX("4A2E801D"):DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  331. 3820       END IF 
  332. 3830      END IF 
  333. 3840     END IF 
  334. 3850     p=p+2
  335. 3860     IF p>=fl THEN EXIT N
  336. 3870    END FOR N
  337. 3880    IF p>fl THEN 
  338. 3890     BLOCK#4;100,10,0,0,4
  339. 3900    ELSE 
  340. 3910     BLOCK#4;INT((p/fl)*100),10,0,0,4
  341. 3920    END IF 
  342. 3930   END REPeat find_loop
  343. 3940  END IF 
  344. 3950 END DEFine 
  345. 3960 :
  346. 3970 DEFine PROCedure fixQLIB
  347. 3980  LOCal l,N,i,X
  348. 3990  RecogFlg%=0
  349. 4000  X=find("Libe"&"rati",FILL$(CHR$(223),8),base,0,fl)
  350. 4020  IF X<>-1 THEN 
  351. 4025  RecogFlg%=-1
  352. 4030   REPeat loop
  353. 4040    X=X-1:IF PEEK(base+X)=0 THEN EXIT loop
  354. 4050   END REPeat loop
  355. 4060   l=PEEK_W(base+X)
  356. 4070   RESTORE 4880
  357. 4080   READ N:l=l-N-N:POKE_W base+X,l:POKE_L base+X+2,STRINGL(":-)"&CHR$(10)):X=X+l+2
  358. 4090   FOR i=0 TO N-1
  359. 4100    READ temp$:POKE_W base+X+i+i,HEX(temp$)
  360. 4110   NEXT i
  361. 4120   IF PEEK_W(base+6)<>HEX("4AFB") THEN 
  362. 4130    RPORT "QLIB CODE:"&CHR$(10)
  363. 4140   ELSE 
  364. 4150    RPORT "QLIB TASK:"&CHR$(10)
  365. 4160   END IF 
  366. 4170   p=X+48:CLS#4:CLS#5
  367. 4180   REPeat find_loop
  368. 4190    IF p>fl THEN EXIT find_loop
  369. 4200    FOR N=1 TO 256
  370. 4210     temp$=HEX$(PEEK_L(base+p),32)
  371. 4220     IF temp$=="46FC0000" THEN 
  372. 4230      POKE_L base+p,HEX("027CC0FF"):DISOUT:RPORT "tidying code at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  373. 4240     ELSE 
  374. 4250      IF (temp$=="20728004") THEN 
  375. 4260       POKE_W base+p,HEX("6100"):POKE_W base+p+2,(X+26)-(p+2):DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  376. 4270      ELSE 
  377. 4280       IF (temp$=="26725004") THEN 
  378. 4290        POKE_W base+p,HEX("6100"):POKE_W base+p+2,(X+12)-(p+2):DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  379. 4300       ELSE 
  380. 4310        IF (temp$=="26722004") THEN 
  381. 4320         POKE_W base+p,HEX("6100"):POKE_W base+p+2,X-(p+2)
  382. 4330         IF (HEX$(PEEK_W(base+p+4),32)=="200B") THEN 
  383. 4340          POKE_W base+p+4,HEX("4E71")
  384. 4350         END IF 
  385. 4360         DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  386. 4370        ELSE 
  387. 4380         IF (temp$=="26724004") THEN 
  388. 4390          POKE_W base+p,HEX("6100"):POKE_W base+p+2,(X+6)-(p+2)
  389. 4400          IF PEEK(base+p+18)=HEX("67") THEN 
  390. 4410           IF PEEK(base+p+20)=HEX("65") THEN 
  391. 4420            i=p+22+PEEK(base+p+21)
  392. 4430            IF (PEEK_W(base+i)==HEX("2A0B")) THEN 
  393. 4440             POKE_W base+i,HEX("2A00")
  394. 4450            END IF 
  395. 4460           END IF 
  396. 4470          END IF 
  397. 4480          DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  398. 4490         ELSE 
  399. 4500          IF (temp$=="20322004") THEN 
  400. 4510           POKE_W base+p,HEX("6100"):POKE_W base+p+2,(X+32)-(p+2)
  401. 4520           IF (PEEK_W(base+p+6)==HEX("2040")) THEN 
  402. 4530            POKE_W base+p+6,HEX("4E71")
  403. 4540           END IF 
  404. 4550           DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  405. 4560          ELSE 
  406. 4570           IF (temp$=="24321004") THEN 
  407. 4580            IF (HEX$(PEEK_L(base+p+4),32)=="6A080C82") AND (HEX$(PEEK_L(base+p+8),32)=="FFFFFFFF") AND (HEX$(PEEK_W(base+p+12),16)=="6710") THEN 
  408. 4590             p=p+4:POKE_L base+p,HEX("70FFB480"):POKE_L base+p+4,HEX("6714E98A"):POKE_W base+p+8,HEX("E88A")
  409. 4600            END IF 
  410. 4610            DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  411. 4620           ELSE 
  412. 4630            IF (temp$=="2640586B") THEN 
  413. 4640             IF (HEX$(PEEK_L(base+p+4),32)=="00120800") AND (HEX$(PEEK_L(base+p+8),32)=="001D6714") THEN 
  414. 4650              POKE_W base+p,HEX("6100"):POKE_W base+p+2,(X+16)-(p+2):POKE_L base+p+4,HEX("586B0012"):POKE_L base+p+8,HEX("E5886A14")
  415. 4660              DISOUT:RPORT "32 bit fix at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  416. 4670             END IF 
  417. 4680            END IF 
  418. 4690           END IF 
  419. 4700          END IF 
  420. 4710         END IF 
  421. 4720        END IF 
  422. 4730       END IF 
  423. 4740      END IF 
  424. 4750     END IF 
  425. 4760     p=p+2
  426. 4770     IF p>=fl THEN EXIT N
  427. 4780    END FOR N
  428. 4790    IF p>fl THEN 
  429. 4800     BLOCK#4;100,10,0,0,4
  430. 4810    ELSE 
  431. 4820     BLOCK#4;INT((p/fl)*100),10,0,0,4
  432. 4830    END IF 
  433. 4840   END REPeat find_loop
  434. 4850  END IF 
  435. 4860 END DEFine 
  436. 4870 :
  437. 4880 DATA 24
  438. 4890 DATA "2032","2004","600A","2032","4004","6004","2032","5004"
  439. 4900 DATA "2640","E988","E888","C18B","4E75","2032","8004","6004"
  440. 4910 DATA "2032","2004","2040","E988","E888","C188","4A80","4E75"
  441. 4920 :
  442. 4930 DEFine PROCedure unfixTURBO
  443. 4935  IF STRINGL(versold$)<STRINGL("1.05") THEN 
  444. 4940   RPORT "removing old patches..."&CHR$(10)
  445. 4950   p=0:CLS#4:CLS#5
  446. 4960   REPeat find_loop
  447. 4970    IF p>fl THEN EXIT find_loop
  448. 4980    FOR N=1 TO 256
  449. 4990     temp$=HEX$(PEEK_L(base+p),32)
  450. 5000     IF temp$=="08920007" THEN 
  451. 5010      POKE_L base+p,HEX("422E8AD4"):DISOUT:RPORT "old fix removed at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  452. 5020     ELSE 
  453. 5030      IF temp$=="660203D2" THEN 
  454. 5040       POKE_L base+p,HEX("57EE8AD4"):DISOUT:RPORT "old fix removed at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  455. 5050      ELSE 
  456. 5060       IF temp$(1 TO 6)=="8AD46D" THEN 
  457. 5070         p=p+2:POKE base+p,HEX("66"):DISOUT:RPORT "old fix removed at $"&HEX$(p,32)&CHR$(10):NoRpc%=NoRpc%+1
  458. 5080       END IF 
  459. 5090      END IF 
  460. 5100     END IF 
  461. 5110     p=p+2
  462. 5120     IF p>=fl THEN EXIT N
  463. 5130    END FOR N
  464. 5140    IF p>fl THEN 
  465. 5150     BLOCK#4;100,10,0,0,4
  466. 5160    ELSE 
  467. 5170     BLOCK#4;INT((p/fl)*100),10,0,0,4
  468. 5180    END IF 
  469. 5190   END REPeat find_loop
  470. 5195  END IF 
  471. 5200 END DEFine 
  472. 5210 :
  473. 5220 DEFine PROCedure po(a$)
  474. 5230  POKE_W base+p,HEX(a$):p=p+2
  475. 5240 END DEFine 
  476. 5250 :
  477. 10000 DEFine PROCedure DISOUT
  478. 10010  LOCal loop, preLoop, disLoop
  479. 10020  LOCal r, Ds, Q, N, c, i
  480. 10030  r=Rows/2
  481. 10040  Ds=0
  482. 10050  FOR i=1 TO r
  483. 10060   D(i)=0
  484. 10070  END FOR i
  485. 10080  Q=p-8*r
  486. 10090  IF Q<0 THEN Q=0
  487. 10100  REPeat preLoop
  488. 10110   N=D68K(base+Q,Q\Buff)
  489. 10120   Q=Q+N
  490. 10130   Ds=Ds-D(i)+N
  491. 10140   D(i)=N
  492. 10150   REPeat loop
  493. 10160    i=1+(i MOD r)
  494. 10170    N=N-6
  495. 10180    IF N<=0 THEN EXIT loop
  496. 10190    Ds=Ds-D(i)
  497. 10200    D(i)=0
  498. 10210   END REPeat loop
  499. 10220   IF Q>=p THEN EXIT preLoop
  500. 10230  END REPeat preLoop
  501. 10240  CLS#5
  502. 10250  Q=Q-Ds
  503. 10260  r=Rows
  504. 10270  dflag=0
  505. 10280  REPeat disLoop
  506. 10290   N=D68K(base+Q,Q\Buff)
  507. 10300   i=0:P$=" "
  508. 10310   REPeat loop
  509. 10320    c=PEEK(Buff+i)
  510. 10330    IF c=0 THEN EXIT loop
  511. 10340    i=i+1
  512. 10350    P$=P$(1 TO LEN(P$))&CHR$(c)
  513. 10360   END REPeat loop
  514. 10370   IF (Q<=p) AND ((Q+N)>p) THEN 
  515. 10380    IF dflag AND NOT("tas" INSTR P$(1 TO LEN(P$)))
  516. 10390     P$=P$(1 TO 14)&"         dc.w      $"&P$(11 TO 14)&CHR$(10):dflag=1:N=2
  517. 10400     INK#5;4
  518. 10410    ELSE 
  519. 10420     INK#5;7
  520. 10430    END IF 
  521. 10440   ELSE 
  522. 10450    INK#5;4
  523. 10460     dflag="dc." INSTR P$(1 TO LEN(P$))
  524. 10470   END IF 
  525. 10480   Q=Q+N
  526. 10490   r=r-((N+5) DIV 6)
  527. 10500   IF r<0 THEN EXIT disLoop
  528. 10510   PRINT#5;P$(1 TO LEN(P$));
  529. 10520  END REPeat disLoop
  530. 10530 END DEFine 
  531. 10540 :
  532. 10550 DEFine FuNction FILE_CLASS$(i$)
  533. 10560  i=0
  534. 10570  REPeat check_loop
  535. 10580   j="_" INSTR i$(i+1 TO LEN(i$))
  536. 10590   IF j=0 THEN EXIT check_loop
  537. 10600   i=i+j
  538. 10610   IF i=LEN(i$) THEN RETurn ""
  539. 10620  END REPeat check_loop
  540. 10630  IF i=0 THEN 
  541. 10640   j=-1
  542. 10650  ELSE 
  543. 10660   IF (i=5) AND (i$(1 TO i) INSTR "ram1_ram2_flp1_flp2_mdv1_mdv2_") THEN 
  544. 10670    j=-1
  545. 10680   END IF 
  546. 10690  END IF 
  547. 10700  IF j<>0 THEN 
  548. 10710   j="_"&i$(i+1 TO LEN(i$))&"_" INSTR "_BOOT_"
  549. 10720   SELect ON j
  550. 10730   =1:a$="SuperBASIC boot program"
  551. 10740   =REMAINDER :a$=""
  552. 10750   END SELect 
  553. 10760   RETurn a$
  554. 10770  ELSE 
  555. 10780   a$=""
  556. 10790   j=(i$(i TO LEN(i$))&"_") INSTR "_c_h_bas_fth_asm_list_txt_text_scr_doc_aba_prg_grf_hob_arc_zip_font_fnt_boot_asc_screen_dbf_scn_log_task_job_bin_code_rext_inc_"
  557. 10800   SELect ON j
  558. 10810   =1:a$="C source"
  559. 10820   =3:a$="C header file"
  560. 10830   =5:a$="SuperBASIC program"
  561. 10840   =9:a$="FORTH program"
  562. 10850   =13:a$="Assembler source"
  563. 10860   =17:a$="Assembler list file"
  564. 10870   =123:a$="Assembler include file"
  565. 10880   =22,26,77,96:a$="ASCII text file"
  566. 10890   =31,81:a$="Screen-save"
  567. 10900   =35:a$="QUILL wordprocess document"
  568. 10910   =39:a$="ABACUS spreadsheet document"
  569. 10920   =43:a$="ARCHIVE program document"
  570. 10930   =88:a$="ARCHIVE database file"
  571. 10940   =92:a$="ARCHIVE screen layout"
  572. 10950   =47:a$="EASEL chart document"
  573. 10960   =51:a$="Psion help file"
  574. 10970   =55:a$="ARC file archive"
  575. 10980   =59:a$="ZIP file archive"
  576. 10990   =63,68:a$="Alternative character set"
  577. 11000   =72:a$="SuperBASIC boot program"
  578. 11010   =100,105:a$="executable TASK"
  579. 11020   =109,113:a$="Machine code"
  580. 11030   =118:a$="Resident extension code"
  581. 11040   =REMAINDER :a$=""
  582. 11050   END SELect 
  583. 11060  END IF 
  584. 11070  RETurn a$
  585. 11080 END DEFine 
  586. 11090 :
  587. 11100 DEFine FuNction WAITKEY$(Chan%,i$)
  588. 11110  LOCal K$(1),i,l,prompt_loop,get_loop
  589. 11120  RPORT " ("
  590. 11130  i=1:l=LEN(i$)
  591. 11140  REPeat prompt_loop
  592. 11150   RPORT i$(i):i=i+1
  593. 11160   IF i>l THEN EXIT prompt_loop
  594. 11170   RPORT "/"
  595. 11180  END REPeat prompt_loop
  596. 11190  RPORT ")? >"
  597. 11200  CURSEN#Chan%
  598. 11210  REPeat get_loop
  599. 11220   K$=INKEY$(#Chan%,-1)
  600. 11230   IF K$ INSTR i$ THEN EXIT get_loop
  601. 11240  END REPeat get_loop
  602. 11250  CURDIS#Chan%
  603. 11260  RPORT K$&CHR$(10)
  604. 11270  RETurn K$
  605. 11280 END DEFine 
  606. 11290 :
  607. 11300 DEFine PROCedure RPORT(temp$)
  608. 11310  PRINT#3;temp$;
  609. 11320 END DEFine 
  610. 11330 :
  611. 11340 DEFine FuNction find(txt$,msk$,base,s,e)
  612. 11350  LOCal i,j,K,l
  613. 11360  CLS#4
  614. 11370  l=-1
  615. 11380  i=s
  616. 11390  REPeat i_loop
  617. 11400   j=0
  618. 11410   REPeat j_loop
  619. 11420    K=0
  620. 11430    REPeat k_loop
  621. 11440     IF (PEEK(base+i+j+K)&&CODE(msk$(K+1)))<>(CODE(txt$(K+1))&&CODE(msk$(K+1))) THEN EXIT k_loop
  622. 11450     K=K+1
  623. 11460     IF K=LEN(txt$) THEN 
  624. 11470      l=i+j:EXIT i_loop
  625. 11480     END IF 
  626. 11490    END REPeat k_loop
  627. 11500    j=j+1
  628. 11510    IF j=256 THEN EXIT j_loop
  629. 11520   END REPeat j_loop
  630. 11530   IF i>=e THEN 
  631. 11540    BLOCK #4,100,10,0,0,4
  632. 11550   ELSE 
  633. 11560    BLOCK#4;((i-s)/(e-s))*100,10,0,0,4
  634. 11570   END IF 
  635. 11580   i=i+256
  636. 11590   IF (i-e)>=256 THEN EXIT i_loop
  637. 11600  END REPeat i_loop
  638. 11610  RETurn l
  639. 11620 END DEFine 
  640. 11630 :
  641.